home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS11.ADF / Modula-2 / Trails / Trails.MOD < prev    next >
Text File  |  1986-08-05  |  8KB  |  285 lines
  1. (*$T- Who needs range checking !!! *)
  2. (*$S- Don't check the stack...     *)
  3. MODULE Trails;
  4.  
  5. (* Just another cute demo of Amiga graphics and menus, etc.
  6.  
  7.    Created: 5/22/86 by Richard Bielak
  8.    
  9.    Modified:
  10.  
  11.     Copyright (c) 1986 by Richard Bielak
  12.     
  13.     This program can be freely copied, but please
  14.     leave my name in. Thanks, Richie.
  15.  
  16. *)
  17. FROM SYSTEM    IMPORT ADR, BYTE, ADDRESS, SETREG;
  18. FROM Intuition IMPORT IntuitionName, IntuitionBase, WindowPtr, ScreenPtr,
  19.                       IntuiMessagePtr, IDCMPFlags, IDCMPFlagsSet;
  20. FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, Jam2, Jam1, 
  21.      Complement, DrawingModeSet;
  22. FROM Pens     IMPORT Draw, Move, SetAPen, SetDrMd, RectFill;
  23. FROM Libraries  IMPORT OpenLibrary;
  24. IMPORT Windows;
  25. FROM Terminal   IMPORT WriteString, WriteLn;
  26. FROM Ports      IMPORT WaitPort, ReplyMsg, MessagePtr;
  27. FROM Fixes      IMPORT GetMsg;
  28. FROM InputEvents IMPORT LButton, UpPrefix;
  29. FROM Screens    IMPORT CloseScreen, ShowTitle;
  30.  
  31. (* The modules below are home grown *)
  32. FROM TrailsMenu IMPORT ConnectMenu, DisconnectMenu, TrailsMenuType,
  33.                        ActionItemType, SymetryItemType, SizeItemType,
  34.                SquareSizeItemType;
  35. FROM TrailsScreen IMPORT SetUpScreen;
  36. FROM TrailsInfo IMPORT ShowTrailsInfo, InitTrailsInfo;
  37. FROM DecodeMenu IMPORT MenuNull, MenuNumber, ItemNumber;
  38.  
  39. CONST
  40.   IntuitionRev = 29;
  41.   MaxTrailLength = 128;
  42.  
  43. TYPE
  44.   point = RECORD
  45.             x, y : INTEGER;
  46.           END;
  47. VAR
  48.   NULL : ADDRESS;
  49.   wp : WindowPtr;
  50.   sp : ScreenPtr;
  51.  
  52.   (* These variables hold the state of things *)
  53.   ButtonDown : BOOLEAN;            (* TRUE if the mouse button is down *)
  54.   SizeOfTrail : INTEGER;        (* Size of trail, -1 if unlimited *)
  55.   SizeOfSquare : INTEGER;       (* Size of the square we draw *)
  56.   NumberOfSymetries : CARDINAL; (* Number of symetries *)
  57.       
  58.   (* This array is used for erasing of old trails *)
  59.   OldTrails : ARRAY [0..MaxTrailLength-1] OF point;
  60.   EndOfTrail: INTEGER;
  61.  
  62. (* ++++++++++++++++++++++++++++++++++ *)
  63. PROCEDURE InitOldTrails ();
  64.   VAR i : CARDINAL;
  65.   BEGIN
  66.     FOR i := 0 TO MaxTrailLength-1 DO 
  67.       WITH OldTrails[i] DO x := -1; y := -1  END
  68.     END;
  69.   END InitOldTrails;
  70.  
  71. (* ++++++++++++++++++++++++++++++++++ *)
  72. PROCEDURE OpenLibraries () : BOOLEAN;
  73.   BEGIN
  74.     (* Open intuition library *)
  75.     IntuitionBase := OpenLibrary (IntuitionName,IntuitionRev);
  76.     IF IntuitionBase = 0 THEN
  77.       WriteString ("Open intuition failed"); WriteLn;
  78.       RETURN FALSE
  79.     END;
  80.     (* Now open the graphics library *)
  81.     GraphicsBase := OpenLibrary (GraphicsName, 0);
  82.     IF GraphicsBase = 0 THEN 
  83.       WriteString ("Open of graphics library failed "); WriteLn;
  84.       RETURN FALSE 
  85.     END;
  86.     RETURN TRUE
  87.   END OpenLibraries;
  88.  
  89. (* ++++++++++++++++++++++++++++++++++++ *)
  90. PROCEDURE ProcessMenuRequest (code : CARDINAL; VAR quit : BOOLEAN);
  91.   VAR
  92.     menu, item : CARDINAL;
  93.  
  94.   (* +++++++++++++++++++++++++++++++ *)
  95.   PROCEDURE ClearScreen (wp : WindowPtr);
  96.     BEGIN
  97.       WITH wp^ DO
  98.         SetAPen (RPort^,0); SetDrMd (RPort^, Jam1);
  99.     RectFill (RPort^, 0,0, 639, 199);
  100.       END;
  101.       InitOldTrails ()
  102.     END ClearScreen;
  103.  
  104.   BEGIN
  105.     menu := MenuNumber (code); item := ItemNumber (code);
  106.     CASE TrailsMenuType (menu) OF
  107.       Actions:
  108.         CASE ActionItemType (item) OF
  109.           HideTitle:   ShowTitle (sp^, FALSE);      |
  110.       UnHideTitle: ShowTitle (sp^, TRUE);      |
  111.       AboutTrails: ShowTrailsInfo (wp);      |
  112.       ClearTrails: ClearScreen (wp);      |
  113.       QuitTrails:  quit := TRUE
  114.     END;
  115.       |
  116.       Symetry:
  117.     CASE SymetryItemType (item) OF
  118.       OneFold:  NumberOfSymetries := 1;    |
  119.       TwoFold:  NumberOfSymetries := 2;    |
  120.       FourFold: NumberOfSymetries := 4;
  121.     END;
  122.       |
  123.       Size:
  124.         CASE SizeItemType (item) OF
  125.           Size16:  SizeOfTrail := 16; |
  126.           Size32:  SizeOfTrail := 32; |
  127.           Size64:  SizeOfTrail := 64; |
  128.           Size128:  SizeOfTrail := 128; |
  129.       Infinite: SizeOfTrail := -1
  130.     END
  131.       |
  132.       SquareSize:
  133.         CASE SquareSizeItemType (item) OF
  134.       Size2by2: SizeOfSquare := 2;    |
  135.       Size4by4: SizeOfSquare := 4;    |
  136.       Size8by8: SizeOfSquare := 8;    |
  137.       Size16by16: SizeOfSquare := 16; |
  138.       Size32by32: SizeOfSquare := 32; |
  139.     END
  140.     END;
  141.   END ProcessMenuRequest;
  142.  
  143. (* ++++++++++++++++++++++++++++++++++++ *)
  144. PROCEDURE ProcessButton (code : CARDINAL);
  145.   BEGIN
  146.     (* If the button was just pressed, make    *)
  147.     (* Intuition report positions of the Mouse *)
  148.     ButtonDown := code = LButton;
  149.     Windows.ReportMouse (wp^, ButtonDown)
  150.   END ProcessButton;
  151.  
  152. (* ++++++++++++++++++++++++++++++++++++ *)
  153. PROCEDURE ProcessMouseMove (newX, newY : INTEGER);
  154.  
  155.   (* ++++++++++++++++++++++++++++++++++++ *)
  156.   PROCEDURE DrawSquare (Xmin, Ymin : INTEGER);
  157.     VAR Xmax, Ymax : INTEGER;
  158.     BEGIN
  159.       WITH wp^ DO
  160.         (* Two pixels in the X direction are as *)
  161.     (* wide as one pixel in the Y direction *)
  162.     Xmax := Xmin + 2 * SizeOfSquare;
  163.     IF Xmax > 640 THEN Xmax := 640; END;
  164.     Ymax := Ymin + SizeOfSquare;
  165.     IF Ymax > 200 THEN Ymax := 200; END;
  166.         (* Note that Xmax >= Xmin and Ymax >= Ymin  *)
  167.     (* otherwise we'll have a spectacular crash *)
  168.     RectFill (RPort^, Xmin, Ymin, Xmax, Ymax);
  169.       END
  170.     END DrawSquare;
  171.  
  172.   (* ++++++++++++++++++++++++++++++++++++ *)
  173.   PROCEDURE DrawTrail (X,Y : INTEGER; color : CARDINAL); 
  174.     VAR x1, y1 : INTEGER;
  175.     BEGIN
  176.       (* Set color of the drawing pen, and set *)
  177.       (* drawing mode to XOR.                  *)
  178.       SetAPen (wp^.RPort^,color); 
  179.       SetDrMd (wp^.RPort^, DrawingModeSet {Complement});
  180.       (* Draw the symetric picture *)
  181.       DrawSquare (X, Y);
  182.       DrawSquare (640 - X, 200 - Y);
  183.       IF NumberOfSymetries >= 2 THEN
  184.         DrawSquare (X, 200 - Y);
  185.         DrawSquare (640 - X, Y);
  186.       END;
  187.       IF NumberOfSymetries >= 4 THEN
  188.         x1 := 16*(Y-100) DIV 5;
  189.     y1 := 5*(X-320) DIV 16;
  190.         DrawSquare ( x1 + 320, y1 + 100);
  191.         DrawSquare (320 - x1, y1 + 100);
  192.         DrawSquare (x1 + 320, 100 - y1);
  193.         DrawSquare (320 - x1, 100 - y1);
  194.       END
  195.     END DrawTrail;
  196.  
  197.   BEGIN
  198.     (* Do anything, only if the button is down *)
  199.     IF ButtonDown THEN
  200.       (* Finite trail *)
  201.       IF SizeOfTrail > 0 THEN
  202.         WITH OldTrails [EndOfTrail] DO
  203.           (* First erase the end of the trails, if it's there *)
  204.           IF x >= 0 THEN        
  205.             DrawTrail (x, y, 0);
  206.           END;
  207.           (* Remmember new trails *)
  208.       x := newX; y := newY;    
  209.       DrawTrail (x, y, 1);
  210.         END;
  211.         (* Bump the trail counter *)
  212.         INC (EndOfTrail);
  213.     IF EndOfTrail >= SizeOfTrail THEN
  214.           EndOfTrail := 0
  215.     END
  216.       (* Very long trail *)
  217.       ELSE
  218.        DrawTrail (newX, newY, 1);
  219.       END;
  220.     END
  221.   END ProcessMouseMove;
  222.  
  223. (* ++++++++++++++++++++++++++++++++++++ *)
  224. PROCEDURE DoTrails ();
  225.   VAR
  226.     MsgPtr : IntuiMessagePtr;
  227.     Quit   : BOOLEAN;
  228.     code   : CARDINAL;
  229.     class  : IDCMPFlagsSet;
  230.     x, y   : CARDINAL;
  231.   BEGIN
  232.     Quit := FALSE;
  233.  
  234.     (* Initialize state variables *)
  235.     ButtonDown := FALSE;
  236.     SizeOfTrail := 64;
  237.     SizeOfSquare := 4;;
  238.     NumberOfSymetries := 2;
  239.     EndOfTrail := 0;
  240.  
  241.     (* Get messages from intuition, and process them *)
  242.     REPEAT
  243.       (* Wait for a message *)
  244.       MsgPtr := WaitPort (wp^.UserPort);
  245.       (* Got something, process it *)
  246.       REPEAT
  247.         MsgPtr := GetMsg(wp^.UserPort);     
  248.         IF MsgPtr <> NULL THEN
  249.           class := MsgPtr^.Class; code := MsgPtr^.Code;
  250.           x := MsgPtr^.MouseX; y := MsgPtr^.MouseY;
  251.           ReplyMsg (MsgPtr);
  252.           IF (class = IDCMPFlagsSet {MouseButtons}) THEN
  253.         ProcessButton (code)
  254.           ELSIF (class = IDCMPFlagsSet {MouseMove}) THEN
  255.             ProcessMouseMove (x,y);
  256.           ELSIF (class = IDCMPFlagsSet {MenuPick}) AND (code <> MenuNull)
  257.         THEN
  258.         ProcessMenuRequest (code, Quit)
  259.       END;
  260.     END; (* IF *)
  261.       UNTIL MsgPtr = NULL
  262.     UNTIL Quit
  263.   END DoTrails;
  264.  
  265. VAR
  266.   i : CARDINAL;
  267. BEGIN
  268.   (* Note "NIL" is not equal to ADDRESS (0) !!!! *)
  269.   NULL := ADDRESS (0);
  270.   InitOldTrails ();
  271.   IF OpenLibraries () THEN  
  272.     InitTrailsInfo ();
  273.     SetUpScreen (wp, sp);
  274.     (* Attach menu to the window *)
  275.     ConnectMenu (wp);
  276.     (* Don't report mouse until Button is clicked *)
  277.     Windows.ReportMouse (wp^, FALSE);
  278.     DoTrails ();
  279.     DisconnectMenu (wp);
  280.     (* Close the window and screen  *)
  281.     Windows.CloseWindow (wp^);
  282.     CloseScreen (sp^);
  283.   END (* IF *)
  284. END Trails.
  285.